home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Compute! Gazette 1988 August
/
1988-08.d64
/
sp font editor
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-09-20
|
7KB
|
246 lines
10 rem copyright 1988 compute! publications, inc. - all rights reserved
20 print"[147][208]lease wait...":gosub2220:goto820
30 print"[147]":gosub2220:goto820
40 rem draw screen
50 rem given c=char #, ch=addr of char
60 gosub260:iffl%(c)thengosub210:gosub320:goto80
70 gosub240:gosub290
80 rem entry w/o grid
90 printvt$(16)tab(14)"[152]<--[213]"
100 print""tab(16)"[211]peed[208]rint [198]ont [197]ditor"
110 printtab(20)"[152][195]opyright 1988":printtab(16)"[195][207][205][208][213][212][197]! [208]ublications"
120 printtab(17)"[193]ll [210]ights [210]eserved"
130 printvt$(8)t$"[155]--- [195]ommands ---":printt$"<cursor keys>"
140 printt$"<[210][197][212][213][210][206]><[200][207][205][197]><[195][204][210]>":printt$"<[211][208][195]>[152] toggle pixel"
150 printt$"+[152] next char":printt$"-[152] prev char"
160 printt$"shft +[152] next entry":printt$"shft -[152] prev entry"
170 printt$"[208][152]rint current char":printt$"shft [208][152] print string"
180 printt$"[199][152]oto [195][152]opy":printt$"[204][152]oad [211][152]ave"
190 printt$"[201][152]nclude [197][152]xclude":printt$"[193][152][211][195][201][201] [209][152]uit"
200 return
210 rem draw grid
220 printco$(0)""bo$
230 fori=0to2:printco$(i);:forj=1to7:printli$:next:next:printbo$:return
240 rem erase grid
250 print"";:fori=1to23:print" ":next:return
260 rem update char display
270 printvt$(3)tab(15)"[195]har: "qu$chr$(c)qu$
280 printvt$(3)tab(25)"= [195][200][210]$("c"[157] ) ":return
290 rem not altered message
300 printvt$(9)"[155] *[195]haracter *":print" * [206]ot in *":print" *[193]lteration*"
310 print" * [204]ist *":return
320 rem mem to grid
330 rem given ch=addr of char
340 ad=ch:y=0
350 gosub420
360 fory=0to14step7
370 forx=0to5:by=peek(ad+x):ifby=0then400
380 bi=1:foryy=0to6:ifbiandbythenprintvt$(y+yy)tab(fnht(x))co$(y/7)" [146]"
390 bi=bi*2:nextyy
400 nextx:ad=ad+6:nexty
410 gosub440:return
420 rem wait
430 pokeso,0:printvt$(9)"******":print" wait ":print"******":return
440 rem end wait
450 printvt$(9)" ":print" ":print" ":return
460 rem toggle pixel
470 rem given set=0/1: clr/set, x,y=co-ords, ch=addr of char
480 by=ch+int(y/7)*6+x:bi=2^(y-int(y/7)*7):set=1+((peek(by)andbi)>0)
490 printvt$(y)tab(fnht(x))co$(y/7)set$(set);
500 pokeby,(peek(by)and255-bi)orbi*set
510 return
520 rem print string
530 rem given ms$=string
540 open1,4,7:fori=0to2
550 fori=0to2:forj=0to1:mo=-(i=2andj=1):print#1,pb$;:fork=1tolen(ms$)
560 a=asc(mid$(ms$,k,1)):m=me+a*18:iffl%(a)then600
570 ifi<>1andmo=0thenprint#1,tx$" ";:goto610
580 ifi=1thenprint#1,tx$chr$(a);:goto610
590 print#1,hr$chr$(26)chr$(6)chr$(132);:goto610
600 print#1,hr$;:forl=0to5:print#1,chr$(peek(m+i*6+l)or128or4*mo);:next
610 next:next:print#1,hr$cr$tx$;:next:close1:return
620 rem inquire
630 rem given ms$=message
640 pokeso,0:fori=1to10:geta$:next:ifm2$=""thenms$=ms$+" (y/n)?":goto660
650 m2$=m2$+" (y/n)?"
660 print""vt$(5)tab(15)ms$:print""tab(15)m2$
670 geta$:ifa$<>"y"anda$<>"n"then670
680 printtab(15)"[145][145]"bl$""tab(15)bl$:m2$="":return
690 rem message
700 rem given ms$,m2$=message
710 pokeso,0:print""vt$(5)tab(15)ms$:printtab(15)m2$
720 fori=1to2500:next:m2$="":print"[145][145]"tab(15)bl$""tab(15)bl$:return
730 rem set cursor
740 pokevic,cx*8+72:pokevic+1,cy*8+59:pokeso,1
750 rem get command
760 pokeso,1:pokesc,peek(sc)-1:geta$:ifa$=""then760
770 ifa$=cr$then960
780 fori=1to21:ifa$<>mid$("[145][157] +-[219][221]giepq[147]cls[208]a",i,1)thennext:goto760
790 on i goto840,870,900,930,980,1000,1050,1100,1150,1200
800 on i-10 goto1240,1270,1290,1340,1370,1400,1420,1490,1740,2130
810 on i-20goto2180
820 rem clr and cont
830 print"[147]":gosub40:goto730
840 rem up
850 cy=cy-1:ifcy<0thency=20
860 goto730
870 rem down
880 cy=cy+1:ifcy>20thency=0
890 goto730
900 rem left
910 cx=cx-1:ifcx<0thencx=5
920 goto730
930 rem right
940 cx=cx+1:ifcx>5thencx=0
950 goto730
960 rem return
970 cx=0:goto870
980 rem toggle
990 x=cx:y=cy:gosub460:goto750
1000 rem +
1010 gosub240
1020 c=c+1:ifc>255thenc=32
1030 gosub260:ch=me+c*18:geta$:ifa$="+"then1020
1040 gosub40:goto750
1050 rem -
1060 gosub240
1070 c=c-1:ifc<32thenc=255
1080 gosub260:ch=me+c*18:geta$:ifa$="-"then1070
1090 gosub40:goto750
1100 rem shft +
1110 j=c:gosub240:gosub420
1120 c=c+1:ifc>255thenc=32
1130 iffl%(c)=0andc<>jthen1120
1140 ch=me+c*18:gosub40:goto750
1150 rem shft -
1160 j=c:gosub240:gosub420
1170 c=c-1:ifc<32thenc=255
1180 iffl%(c)=0andc<>jthen1170
1190 goto1140
1200 rem goto
1210 pokeso,0:input"[147][199]oto [215]hich [193][211][195][201][201] [195]ode";a
1220 ifa>31anda<256thenc=a:ch=me+18*c
1230 goto820
1240 rem include
1250 fl%(c)=1
1260 gosub40:goto750
1270 rem exclude
1280 fl%(c)=0:goto1260
1290 rem p
1300 iffl%(c)=0then750
1310 ms$="[208]rint [212]his [195]har":gosub620
1320 ifa$="y"thenms$=" "+chr$(c)+" ":gosub520
1330 goto750
1340 rem quit
1350 ms$="[209]uit [208]rogram":gosub620:ifa$="y"thenprint"[147][155][194]ye.":pokeso,0:end
1360 goto750
1370 rem clr
1380 ms$="[195]lear [195]har":gosub620:ifa$="n"then750
1390 fori=chtoch+17:pokei,0:next:gosub40:goto750
1400 rem home
1410 cx=0:cy=0:goto730
1420 rem copy
1430 pokeso,0:print"[147][195]opy this [195]haracter to [215]hich [193][211][195][201][201]":a=0
1440 input" [195]haracter";a:ifa>255ora<32ora=cthen820
1450 oc=c:c=a:c2=ch:ch=me+18*c:print"[147]":gosub40
1460 ms$="[210]eplace with"+str$(oc):gosub620
1470 ifa$="n"thenc=oc:ch=c2:ms$="** [195]ancelled **":gosub690:goto820
1480 fori=0to17:pokech+i,peek(c2+i):next:gosub40:goto750
1490 rem load
1500 ms$="[204]oad":gosub1630:iffl=1then820
1510 f2%=0:open15,8,15:open1,8,3,fi$:gosub2040:ifflthen820
1520 gosub240:gosub420:gosub2430:get#1,a$,a$,a$,a$:s=0
1530 get#1,a$:ifa$=""then1550
1540 s=s+1:o%(s)=asc(a$+c0$):get#1,a$:goto1530
1550 ifs=0then65535
1560 fori=1tos
1570 printw$;w$(iand3);:cc=o%(i):fl%(cc)=1:m=me+cc*18:forj=0to2:get#1,a$
1580 ifa$=chr$(255)thenfork=0to5:pokem+k,0:next:goto1600
1590 pokem,asc(a$+c0$):fork=1to5:get#1,a$:pokem+k,asc(a$+c0$):next
1600 m=m+6:next:next
1610 gosub80:gosub2040:iffl=0thenclose1:close15:ms$="[198]inished.":gosub690
1620 c=32:goto1100
1630 rem filename
1640 rem given ms$=message
1650 rem returns fi$=filename, fl=1 if error
1660 print"[147]"ms$":":fl=0:fi$="":input"[198]ilename";fi$
1670 ifleft$(fi$,4)="font"andmid$(fi$,7,1)="/"then1700
1680 input"2-character abbreviation";a$:iflen(a$)<>2then1680
1690 fi$="font"+a$+"/"+fi$
1700 print"[147]":gosub80
1710 iflen(fi$)>15thenms$="[198]ilename too long.":gosub690:fl=1:return
1720 ms$=ms$+" with [206]ame:":m2$=qu$+fi$+qu$:gosub620:ifa$="n"thenfl=1
1730 return
1740 rem save
1750 ms$="[211]ave":gosub1630:iffl=1then820
1760 open15,8,15
1770 open1,8,3,fi$+",w,p":input#15,a$,b$,c$,d$:a=val(a$)
1780 ifa<>63then1810
1790 close1:ms$="[210]eplace [198]ile":gosub620:ifa$="n"thenclose15:goto820
1800 print#15,"s0:"+fi$:goto1770
1810 ifa>19thengosub2060:goto820
1820 print#1,chr$(0)chr$(192);:gosub420:f2%=-(fl%(34)=0):iff2%=0then1850
1830 m=me+34*18:fori=mtom+17:pokei,0:next:pokem+7,7:pokem+9,7
1840 fl%(34)=1:rem make sure quote defined
1850 s=0:fori=32to255:s=s+fl%(i):next:s=1+2*s
1860 print#1,chr$(sand255)chr$(s/256);
1870 cc=32:i=0
1880 iffl%(cc)=0then1930
1890 ii=ii+1:printw$;w$(iiand3);
1900 s%=3:m=me+cc*18:fori=0to12step6:s=0:forj=0to5:s=s+peek(m+i+j):next
1910 l%=-(s>0):s%=s%-5*(l%>0):l%(cc,i/6)=l%:next
1920 print#1,chr$(cc)chr$(s%);
1930 cc=cc+1:ifcc<256then1880
1940 print#1,chr$(0);:cc=32
1950 iffl%(cc)=0then2000
1960 ii=ii+1:printw$;w$(iiand3);
1970 m=me+cc*18:fori=0to2:ifl%(cc,i)=0thenprint#1,chr$(255);:goto1990
1980 forj=0to5:print#1,chr$(peek(m+j));:next
1990 m=m+6:next
2000 cc=cc+1:ifcc<256then1950
2010 close1:gosub440:gosub2040:iffl=0thenms$="[198]inished.":gosub690
2020 iff2%thenfl%(34)=0
2030 close15:goto820
2040 rem read error
2050 input#15,a$,b$,c$,d$:a=val(a$)
2060 rem entry if already read
2070 ifa<20thenfl=0:return
2080 print"[147][196]isk [197]rror:":printa$" "b$" "c$" "d$" ":fl=1:close1:close15
2090 print"[208]ress [193]ny [203]ey to [195]ontinue....":fori=1to10:geta$:next
2100 geta$:ifa$=""then2100
2110 iff2%thenfl%(34)=0
2120 return
2130 rem shft p